home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM 1995 Fall / PD-ROM F95.toast / Utilities / Text Utils / Alpha 5.81 ƒ / Tcl / SystemCode / tcl.tcl < prev    next >
Encoding:
Text File  |  1994-07-07  |  2.3 KB  |  89 lines  |  [TEXT/ALFA]
  1. proc rebuildTclIndices {} {
  2.     set dir [pwd]
  3.     cd
  4.     message "Building SystemCode index…"
  5.     auto_mkindex :Tcl:SystemCode *.tcl
  6.     message "Building UserCode index…"
  7.     auto_mkindex :Tcl:UserCode *.tcl
  8.     message ""
  9.     cd $dir
  10. }
  11.  
  12.  
  13. proc tclMenuProc {menu item} {
  14.     global tclColoring
  15.  
  16.     eval $item
  17. }
  18.  
  19.  
  20. #===========================================================================
  21. # Debug a Tcl procedure.
  22. #===========================================================================
  23.  
  24. # Alpha TCL programming mode
  25. proc traceTclProc {} {
  26.     global tclMenu
  27.     if {[llength [traceFunc status]]>2} {
  28.         traceFunc off
  29.         markMenuItem $tclMenu traceTclProc off
  30.         dumpTraces
  31.         return
  32.     }
  33.     set func [listpick -p {Func Name:} [lsort [info procs]]]
  34.     if {![string length $func]} return
  35.     traceFunc on $func ""
  36.     catch {markMenuItem $tclMenu traceTclProc on}
  37. }
  38.  
  39. proc setTclMode {} {
  40.     global tclMenu
  41.     changeMode "Tcl"
  42.     uplevel #0 {
  43.         set elecLBrace 0
  44.         set elecRBrace 0
  45.         set electricSemi 0
  46.         set wordWrap 0
  47.         set funcExpr {^proc *([+-a-zA-Z0-9]+)}
  48.         set wordBreakPreface {[^a-zA-Z0-9_\$]}
  49.         set wordBreak {(\$)?[a-zA-Z0-9_]+}
  50.         set funcPar 1
  51.         set sortedIsDefault 1
  52.         set prefixString "# "
  53.     }
  54.     insertMenu $tclMenu
  55. }
  56.  
  57. #================================================================================
  58. proc tclMarkFile {} {
  59.     global mpos
  60.     
  61.     set end [maxPos]
  62.     set pos 0
  63.     set l {}
  64.     while {![catch {search -f 1 -r 1 -m 0 -i 0 {^proc} $pos} res]} {
  65.         set start [lindex $res 0]
  66.         set end [nextLineStart $start]
  67.         set text [lindex [getText $start $end] 1]
  68.         set pos $end
  69.         set inds($text) [lineStart [expr $start - 1]]
  70.     }
  71.  
  72.     if {[info exists inds]} {
  73.         foreach f [lsort [array names inds]] {
  74.             set next [nextLineStart $inds($f)]
  75.             setNamedMark $f $inds($f) $next $next
  76.         }
  77.     }
  78. }
  79.  
  80.  
  81.  
  82. #================================================================================
  83. # Colorize tcl code.
  84. #================================================================================
  85.  
  86. set tclKeywords {append array break case catch cd close concat continue elseif else eof error eval exec exit expr file flush foreach format for gets global glob history if incr info join lappend library lindex linsert list llength lrange lreplace lsearch lsort open pid proc puts pwd read regexp regsub rename return scancontext scan seek set source split string switch tell time trace unknown unset uplevel upvar while}
  87.  
  88. regModeKeywords -e {#} -c red -k blue Tcl $tclKeywords
  89.